home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 09 - 1993 / 09.01 Jan 93 / XCMD Etiquette / stringWidth.p next >
Encoding:
Text File  |  1992-12-03  |  6.5 KB  |  217 lines  |  [TEXT/PJMM]
  1.  
  2. unit stringWidthUnit;
  3. {}
  4. { LSP Project contains: }
  5. { XCMDIntf.p }
  6. { XCMDUtils.p }
  7. { Interface.lib }
  8. { DRVRRuntime.lib }
  9. { stringWidth.p (this file ) }
  10. {}
  11. { syntax is:stringWidth(stringHolder, font, size,}
  12. { style,<noDialog>) }
  13. { the parameters should be specified as hypercard }
  14. { reports them, ie. }
  15. { stringWidth("this is a dummy string", "PALATINO",}
  16. { "14", "BOLD,ITALIC", "noDialog") }
  17. {}
  18. { copyright (©)  Eric Carlson and Jeremy Ahouse }
  19. { April 29, 1989 }
  20. { Waves Cosulting and Development }
  21. { Berkeley, CA     94792 }
  22. { free for non-commercial use only }
  23. {}
  24. interface
  25.     uses
  26.         HyperXcmd;
  27.  
  28.     procedure main (paramPtr: XCmdPtr);
  29.  
  30. implementation
  31.  
  32. {------------------------------------------------}
  33.  
  34.     procedure reportToUser (var paramPtr: XCmdPtr;
  35.                                     msgStr: str255);
  36. {}
  37. { report something back to the user.  we always fill }
  38. { in the result field of the paramBlock, and optionally }
  39. { use HC's "answer" dialog unless requested not to }
  40. {}
  41.         var
  42.             tempName: str255;
  43.     begin
  44.         paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
  45. {check the last param to see if the user requested that}
  46. { we suppress the error dialog }
  47.         ZeroToPas(paramPtr, paramPtr^.params[paramPtr^.paramCount]^, tempName);
  48.         UprString(tempName, true);
  49.         if tempName <> 'NODIALOG' then
  50.             SendCardMessage(paramPtr, concat('answer "', msgStr, '"'));
  51.     end;    { procedure }
  52.  
  53.     function askedForHelp (var paramPtr: XCmdPtr;
  54.                                     syntaxMsg: Str255;
  55.                                     copyRightMsg: Str255): boolean;
  56. {}
  57. {    check to see if the user sent a '?' or a '??' as }
  58. { the only parameter. if so we will respond with }
  59. { the calling syntax or the copyright/version info }
  60. { for this external }
  61. {}
  62.         var
  63.             firstStr: str255;
  64.     begin
  65.         askedForHelp := false;
  66.         if paramPtr^.paramCount = 1 then
  67.             begin
  68.                 ZeroToPas(paramPtr, paramPtr^.params[1]^, firstStr);
  69.                     { what is the first param? }
  70.                 if firstStr = '?' then
  71.                     begin
  72.                         reportToUser(paramPtr, syntaxMsg);
  73.                         askedForHelp := true
  74.                     end    { asked for help }
  75.                 else if firstStr = '??' then
  76.                     begin
  77.                         reportToUser(paramPtr, copyRightMsg);
  78.                         askedForHelp := true
  79.                     end;    { asked for copyright info }
  80.             end;    { one parameter passed }
  81.     end;    { function }
  82.  
  83.     procedure widthOfString (paramPtr: XCmdPtr);
  84. {}
  85. { set the specified pen characteristics and get the }
  86. { width of the string with the toolbox routine }
  87. { StringWidth }
  88. {}
  89.         label
  90.             1;
  91.         var
  92.             passedString, errorStr, tempName: str255;
  93.             copyRtStr, syntaxStr: str255;
  94.             oldFont, oldSize, fNum, fSize, width: integer;
  95.             fName, sizeString, theStyleStr: Str255;
  96.             oldStyle, theStyle: Style;
  97.             HCPort: GrafPtr;
  98.     begin
  99.         syntaxStr := 'stringWidth(stringHolder, font, size, style, <“noDialog”>)';
  100. { note the use of “smart quotes” so that }
  101. { HC doesn't choke if we use the answer }
  102. { dialog }
  103.         copyRtStr := 'v1.0, ©1989 Waves Consulting and Development, Berkeley CA.';
  104.         if paramPtr^.paramCount = 0 then
  105.             begin
  106.          { no parameters passed, report our calling syntax }
  107.                 reportToUser(paramPtr, syntaxStr);
  108.                 goto 1;
  109.             end;
  110.  
  111.         if not (askedForHelp(paramPtr, syntaxStr, copyRtStr)) then
  112.             begin
  113.                 GetPort(HCPort);                        { grab the port }
  114.                 with HCPort^ do
  115.                     begin
  116.                         oldFont := txFont;        { save current typeface }
  117.                         oldSize := txSize;        { save current size }
  118.                         oldStyle := txFace;    { save current style }
  119.                     end;
  120.  
  121.                 ZeroToPas(paramPtr, paramPtr^.params[1]^, passedString);{ get the string to trim }
  122.  
  123.     { do we have a font name parameter? }
  124.                 if paramPtr^.paramCount > 1 then
  125.                     ZeroToPas(paramPtr, paramPtr^.params[2]^, fName)
  126.                             { which font? }
  127.                 else
  128.                     fName := 'GENEVA';
  129.                             { no font passed, use HCs default }
  130.  
  131.                 fNum := StrToNum(paramPtr, fName);
  132. { check to see if a number was passed as the font }
  133. {'name' parameter. if so, we assume that the font }
  134. { which HC wants to use for the field/button is not }
  135. { available in the current system. in this case geneva }
  136. { is being used instead, so we should use it too! }
  137.                 if fNum <> 0 then
  138.                     fName := 'GENEVA';
  139.                 GetFNum(fName, fNum);            { get the font number }
  140. { if we call for an unavailable font (not present in }
  141. { this system, name spelled incorrectly, etc, GetFNum }
  142. { returns 0, which also happens to be the correct }
  143. { number for CHICAGO.  thus we now check to see if }
  144. { the name for the font num is the same as the font }
  145. { name passed to us, or if our user is requesting the }
  146. { impossible }
  147.                 GetFontName(fNum, tempName);
  148.                 UprString(fName, true);
  149.                 UprString(tempName, true);
  150.                 if tempName <> fName then
  151.                     begin
  152.                         errorStr := concat('Sorry, the font ', chr(39), fName, chr(39), ' is not avaliable.');
  153.                         reportToUser(paramPtr, errorStr);
  154.                         goto 1;
  155.                     end;
  156.  
  157.                 if paramPtr^.paramCount > 2 then
  158.                              { do we have a size parameter? }
  159.                     ZeroToPas(paramPtr, paramPtr^.params[3]^, sizeString) { font size in string form }
  160.                 else
  161.                     sizeString := '12';
  162.                                 { no size passed, use HCs default }
  163.                 fSize := StrToNum(paramPtr, sizeString);
  164.                                 { actual size }
  165.  
  166.                 theStyle := [];
  167.                               { is there a style parameter? }
  168.                 if paramPtr^.paramCount > 3 then
  169.                     begin
  170.                         ZeroToPas(paramPtr, paramPtr^.params[4]^, theStyleStr);    { which style(s)? }
  171.                         UprString(theStyleStr, true);
  172.                          { convert to uppercase }
  173.  
  174.                         if pos('BOLD', theStyleStr) > 0 then
  175.                             theStyle := theStyle + [bold];
  176.                         if pos('ITALIC', theStyleStr) > 0 then
  177.                             theStyle := theStyle + [italic];
  178.                         if pos('UNDERLINE', theStyleStr) > 0 then
  179.                             theStyle := theStyle + [underline];
  180.                         if pos('OUTLINE', theStyleStr) > 0 then
  181.                             theStyle := theStyle + [outline];
  182.                         if pos('SHADOW', theStyleStr) > 0 then
  183.                             theStyle := theStyle + [shadow];
  184.                         if pos('CONDENSE', theStyleStr) > 0 then
  185.                             theStyle := theStyle + [condense];
  186.                         if pos('EXTEND', theStyleStr) > 0 then
  187.                             theStyle := theStyle + [extend];
  188.                     end;
  189.  
  190.         { now setup the port with the specified font }
  191.         { attributes }
  192.                 TextFont(fNum);            { set it to the current font, }
  193.                 TextSize(fSize);            { and the size, }
  194.                 TextFace(theStyle);    { and the style... }
  195.  
  196.                 width := StringWidth(passedString);
  197.                                                         { how wide is that string? }
  198.  
  199.         { we mustn't forget to clean up after ourselves, }
  200.         { reset HC's port to the entry conditions }
  201.                 TextFont(oldFont);    { reset the  font… }
  202.                 TextSize(oldSize);    { and the size… }
  203.                 TextFace(oldStyle);{ and the style }
  204.  
  205.         { send back the width }
  206.                 NumToStr(paramPtr, width, tempName);
  207.                 paramPtr^.returnValue := PasToZero(paramPtr, tempName);
  208.             end;
  209.  
  210. 1:        {bail out point if we run into trouble }
  211.     end;
  212.  
  213.     procedure main;
  214.     begin
  215.         widthOfString(paramPtr);
  216.     end;
  217. end.